home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
DIALOGS
/
JANUSW
/
DYNLINK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-11-14
|
11KB
|
398 lines
{ Unit: DynLink
Version: 1.10
Purpose: DYNAMIC link to DLLs
Developer: Peter Sawatzki (ps)
Buchenhof 3, 58091 Hagen, Germany
CompuServe: 100031,3002
Date: Author:
09/09/93 ps initial release by PS
Copyright (c) 1994 Peter Sawatzki. All Rights Reserved.
}
{$A+,B-,F-,G+,I-,K+,P-,Q-,R-,S-,T-,V-,X+}
Unit DynLink;
Interface
Uses
Objects,
oWindows,
WinTypes,
WinProcs;
Const
DefWarnUser: Boolean = True;
Type
pFunctionCollection = ^tFunctionCollection;
tFunctionCollection = Object(tCollection)
Procedure FreeItem (Item: Pointer); Virtual;
End;
pPointer = ^Pointer;
pFunction = ^tFunction;
tFunction = Record
Name: pChar;
FuncVarAdr: pPointer;
End;
tDll = Object(tObject)
ModuleHandle: tHandle;
ModuleName: pChar;
JumpSeg: tHandle;
FunctionCollection: pFunctionCollection;
Linked, WarnUser: Boolean;
Constructor Init (aName: pChar);
Destructor Done; Virtual;
Procedure InitProcs; Virtual;
Procedure BuildProcsInfo;
Procedure AddFunction (anAddr: Pointer; aName: pChar);
Procedure Link (Index: Word);
Procedure RemoveLinkInfo;
Function LibLink: Bool; Virtual;
Procedure LibUnLink; Virtual;
Function LibPresent: Bool; Virtual;
Procedure LibError; Virtual;
End;
tBWCC = Object(tDll)
DialogBox: Function (Instance: tHandle; Templatename: pChar;
WndParent: hWnd; DialogFunc: tFarProc): Integer;
DialogBoxParam: Function (Instance: tHandle; TemplateName: pChar;
WndParent: hWnd; DialogFunc: tFarProc; InitParam: LongInt): Integer;
CreateDialog: Function (Instance: THandle; TemplateName: PChar;
WndParent: hWnd; DialogFunc: tFarProc): hWnd;
CreateDialogParam: Function (Instance: tHandle; TemplateName: pChar;
WndParent: hWnd; DialogFunc: tFarProc; InitParam: LongInt): hWnd;
MessageBox: Function (WndParent: HWnd; Txt, Caption: pChar; TextType: Word): Integer;
GetPattern: Function: HBrush;
GetVersion: Function: Longint;
SpecialLoadDialog: Function (hResMod: tHandle; Templatename: pChar; DialogFunc: tFarProc): tHandle;
MangleDialog: Function (hDlg: tHandle; hResMod: tHandle; DialogFunc: tFarProc): tHandle;
DefMdiChildProc,
DefWindowProc,
DefDlgProc: tDefaultProc;
Procedure InitProcs; Virtual;
End;
Const
BorDialog = 'BorDlg';
BorDialogGray = 'BorDlg_Gray'; {Borland's new gray BorDlg}
BorButton = 'BorBtn';
BorRadio = 'BorRadio';
BorCheck = 'BorCheck';
BorShade = 'BorShade';
BorStatic = 'BorStatic';
bss_Group = 1; {group box}
bss_Hdip = 2; {horizontal border}
bss_Vdip = 3; {hertical border}
bss_Hbump = 4; {horizontal speed bump}
bss_Vbump = 5; {vertical speed bump}
Type
tCtl3D = Object(tDll)
SubclassDlg: Function (aDialog: hWnd; grbit: Word): Bool;
SubClassDlgEx: Function (aDialog: hWnd; grbit: LongInt): Bool;
GetVer: Function: Word;
Enabled: Function: Bool;
CtlColor: Function (aDC: hDC; lParam: LongInt): hBrush;
CtlColorEx: Function (Message, wParam: Word; lParam: LongInt): hBrush;
ColorChange: Function: Bool;
SubclassCtl: Function (aCtl: hWnd): Bool;
DlgFramePaint: Function (aDialog: hWnd; Message, wParam: Word; lParam: LongInt): LongInt;
AutoSubclass: Function (hInstApp: tHandle): Bool;
Register: Function (hInstApp: tHandle): Bool;
Unregister: Function (hInstApp: tHandle): Bool;
Procedure InitProcs; Virtual;
Function LibLink: Bool; Virtual;
Procedure LibUnLink; Virtual;
End;
Const
{SubClassDlg3d flags}
Ctl3D_Buttons = $0001;
Ctl3D_ListBoxes = $0002;
Ctl3D_Edits = $0004;
Ctl3D_Combos = $0008;
Ctl3D_StaticTexts = $0010;
Ctl3D_StaticFrames= $0020;
Ctl3D_NoDlgWindow =$10000;
Ctl3D_All = $FFFF;
wm_DlgBorder = wm_User+3567;
{wm_DlgBorder return codes}
Ctl3D_NoBorder = 0;
Ctl3D_Border = 1;
wm_DlgSubClass = wm_User+3568;
{wm_DlgSubClass return codes}
Ctl3D_NoSubClass = 0;
Ctl3D_SubClass = 1;
Var
dBWCC: tBWCC;
dCtl3D: tCtl3D;
Implementation
Uses
{$IfDef Debug} Debug, {$EndIf}
Strings;
Procedure tFunctionCollection.FreeItem (Item: Pointer);
Begin
With pFunction(Item)^ Do Begin
If PtrRec(Name).Seg<>0 Then
StrDispose(Name);
End;
Dispose(pFunction(Item))
End;
Constructor tDll.Init (aName: pChar);
Begin
Inherited Init;
FillChar(pChar(pChar(@Self)+2)^, SizeOf(Self) - SizeOf(tObject), 0);
ModuleName:= StrNew(aName);
ModuleHandle:= 0;
JumpSeg:= 0;
FunctionCollection:= New(pFunctionCollection, Init(10, 5));
Linked:= False;
WarnUser:= DefWarnUser;
InitProcs;
BuildProcsInfo
End;
Destructor tDll.Done;
Begin
LibUnLink;
If Assigned(ModuleName) Then Begin
StrDispose(ModuleName);
ModuleName:= Nil
End;
If Assigned(FunctionCollection) Then
Dispose(FunctionCollection, Done);
Inherited Done
End;
Procedure tDLL.AddFunction (anAddr: Pointer; aName: pChar);
Var
aFunction: pFunction;
Begin
If Not Assigned(anAddr) Then
Exit;
aFunction:= New(pFunction);
With aFunction^ Do Begin
If PtrRec(aName).Seg<>0 Then
Name:= StrNew(aName)
Else
Name:= aName;
FuncVarAdr:= anAddr
End;
FunctionCollection^.Insert(aFunction)
End;
Procedure tDLL.InitProcs;
Begin
Abstract
End;
Procedure tDLL.BuildProcsInfo;
Var
p: pByte;
Count, o: Word;
i: Integer;
Begin
Count:= FunctionCollection^.Count;
If Not Assigned(FunctionCollection) Or (Count<=0) Then
Exit;
p:= GlobalLock(GlobalAlloc(gMem_Fixed, Count*3+11));
If Not Assigned(p) Then
Exit;
JumpSeg:= PtrRec(p).Seg;
o:= Count*3-3;
For i:= 0 To Count-1 Do Begin
pFunction(FunctionCollection^.At(i))^.FuncVarAdr^:= p;
p^:= $E8; Inc(p); pWord(p)^:= o; Inc(p,2); {Call Label}
Dec(o, 3)
End;
{Label:}
{Push Seg(Self)} p^:= $68; Inc(p); pWord(p)^:= Seg(Self); Inc(p,2);
{Push Ofs(Self)} p^:= $68; Inc(p); pWord(p)^:= Ofs(Self); Inc(p,2);
{Call tDll.Link} p^:= $9A; Inc(p); pPointer(p)^:= @tDll.Link; Inc(p,4);
ChangeSelector(JumpSeg, JumpSeg)
End;
Procedure tDll.Link (Index: Word);
Var
LinkFunc: pPointer;
Tmp: Array[0..100] Of Char;
Begin
Index:= (Index-3) Div 3;
If Linked Then Begin
{$IfDef Debug} WriteLn('err ', StrPasEx(ModuleName),': method ',
StrPasEx(pFunction(FunctionCollection^.At(Index))^.Name),
' not found.');
{$EndIf}
StrCat(StrCat(StrCopy(Tmp, 'A function in module '), ModuleName),
#13' was not found. The file is probably'+
#13'missing or out of date.');
MessageBox(0, Tmp, 'Fatal Error', mb_IconExclamation+mb_Ok);
Halt
End;
LinkFunc:= pFunction(FunctionCollection^.At(Index))^.FuncVarAdr;
LibLink;
Linked:= True;
Asm
Les Di, LinkFunc
Mov Ax, Es:[Di]
Mov Dx, Es:[Di+2]
Mov [Bp+2], Ax {change return offset}
Mov [Bp+4], Dx {change return segment}
End
End;
Procedure tDLL.RemoveLinkInfo;
Begin
If Assigned(FunctionCollection) Then
Dispose(FunctionCollection, Done);
FunctionCollection:= Nil;
If JumpSeg<>0 Then Begin
ChangeSelector(JumpSeg, JumpSeg);
JumpSeg:= GlobalHandle(JumpSeg);
If JumpSeg<>0 Then Begin
GlobalUnLock(JumpSeg);
GlobalFree(JumpSeg)
End
End;
JumpSeg:= 0
End;
Function tDll.LibLink: Bool;
Var
prevMode: Word;
DiscardLinkInfo: Boolean;
Procedure GetAddr (Item: pFunction); Far;
Var
Addr: Pointer;
Begin With Item^ Do Begin
Addr:= GetProcAddress(ModuleHandle, Name);
If Assigned(Addr) Then
FuncVarAdr^:= Addr
Else Begin
{$IfDef Debug} WriteLn('wn ', StrPasEx(ModuleName),': unable to link to ',StrPasEx(Name)); {$EndIf}
DiscardLinkInfo:= False
End;
End End;
Begin
If ModuleHandle=0 Then Begin
prevMode:= SetErrorMode($8000); {SEM_NoOpenFileErrorBox}
ModuleHandle:= LoadLibrary(ModuleName);
SetErrorMode(prevMode);
If ModuleHandle<32 Then Begin
LibLink:= False;
ModuleHandle:= 0;
LibError;
Exit
End;
DiscardLinkInfo:= True;
FunctionCollection^.ForEach(@GetAddr);
If DiscardLinkInfo Then
RemoveLinkInfo
End;
LibLink:= LibPresent
End;
Procedure tDll.LibUnLink;
Begin
If ModuleHandle<>0 Then Begin
FreeLibrary(ModuleHandle);
ModuleHandle:= 0;
RemoveLinkInfo
End
End;
Function tDll.LibPresent: Bool;
Begin
LibPresent:= ModuleHandle<>0
End;
Procedure tDll.LibError;
Var
Tmp: Array[0..79] Of Char;
Begin
{$IfDef Debug} WriteLn('wn ', StrPasEx(ModuleName),': unable to load DLL'); {$EndIf}
If WarnUser Then Begin
StrCopy(Tmp, 'Unable to load file ');
StrCat(Tmp, ModuleName);
MessageBox(0, Tmp, 'Warning', mb_IconHand+mb_Ok)
End
End;
{- tBWCC}
Procedure tBWCC.InitProcs;
Begin
AddFunction(@@SpecialLoadDialog,pChar(1));
AddFunction(@@DialogBox, pChar(2));
AddFunction(@@DialogBoxParam, pChar(3));
AddFunction(@@CreateDialog, pChar(4));
AddFunction(@@CreateDialogParam,pChar(5));
AddFunction(@@DefDlgProc, pChar(6));
AddFunction(@@MessageBox, pChar(9));
AddFunction(@@GetPattern, pChar(10));
AddFunction(@@GetVersion, pChar(11));
AddFunction(@@MangleDialog, pChar(12));
AddFunction(@@DefWindowProc, pChar(14));
AddFunction(@@DefMdiChildProc, pChar(15));
End;
{- tCtl3D}
Procedure tCtl3D.InitProcs;
Begin
AddFunction(@@GetVer, pChar(1));
AddFunction(@@SubclassDlg, pChar(2));
AddFunction(@@SubclassCtl, pChar(3));
AddFunction(@@CtlColor, pChar(4));
AddFunction(@@Enabled, pChar(5));
AddFunction(@@ColorChange, pChar(6));
AddFunction(@@Register, pChar(12));
AddFunction(@@Unregister, pChar(13));
AddFunction(@@AutoSubclass, pChar(16));
AddFunction(@@CtlColorEx, pChar(18));
AddFunction(@@DlgFramePaint, pChar(20));
AddFunction(@@SubClassDlgEx, pChar(21));
End;
Function tCtl3D.LibLink: Bool;
Begin
If Inherited LibLink Then
LibLink:= Register(System.hInstance)
Else
LibLink:= False
End;
Procedure tCtl3D.LibUnLink;
Begin
If ModuleHandle<>0 Then
UnRegister(System.hInstance);
Inherited LibUnLink
End;
Var
PrevExit: Pointer;
Procedure DynLinkExit; Far;
Begin
ExitProc:= PrevExit;
dBWCC.Done;
dCtl3D.Done;
End;
Begin
PrevExit:= ExitProc;
ExitProc:= @DynLinkExit;
dBWCC.Init('BWCC.DLL');
dCtl3D.Init('CTL3DV2.DLL');
End.